home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
a_utils
/
yacc
/
flexyacc
/
aflex.lha
/
aflex
/
src
/
template_managerB.a
< prev
next >
Wrap
Text File
|
1993-05-31
|
18KB
|
476 lines
-- Copyright (c) 1990 Regents of the University of California.
-- All rights reserved.
--
-- This software was developed by John Self of the Arcadia project
-- at the University of California, Irvine.
--
-- Redistribution and use in source and binary forms are permitted
-- provided that the above copyright notice and this paragraph are
-- duplicated in all such forms and that any documentation,
-- advertising materials, and other materials related to such
-- distribution and use acknowledge that the software was developed
-- by the University of California, Irvine. The name of the
-- University may not be used to endorse or promote products derived
-- from this software without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
-- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-- TITLE template manager
-- AUTHOR: John Self (UCI)
-- DESCRIPTION supports output of internalized templates for the IO and DFA
-- packages.
-- NOTES This package is quite a memory hog, and is really only useful on
-- virtual memory systems. It could use an external file to store the
-- templates like the skeleton manager. This would save memory at the
-- cost of a slight reduction in speed and the necessity of keeping
-- copies of the template files in a known place.
-- $Header: /dc/uc/self/arcadia/aflex/ada/src/RCS/template_managerB.a,v 1.21 1992/12/29 22:46:15 self Exp self $
with FILE_STRING, MISC_DEFS, TEXT_IO, EXTERNAL_FILE_MANAGER, MISC, TSTRING; use
FILE_STRING, MISC_DEFS, TEXT_IO;
package body TEMPLATE_MANAGER is
type FILE_ARRAY is array(POSITIVE range <>) of VSTRING;
DFA_TEMPLATE : constant FILE_ARRAY := (
--DFA TEMPLATE START
VSTR("yytext_ptr : integer; -- points to start of yytext in buffer"),
VSTR(""),
VSTR("-- yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need"),
VSTR("-- to put in 2 end-of-buffer characters (this is explained where it is"),
VSTR("-- done) at the end of yy_ch_buf"),
VSTR("YY_READ_BUF_SIZE : constant integer := 8192;"),
VSTR("YY_BUF_SIZE : constant integer := YY_READ_BUF_SIZE * 2; -- size of input buffer"),
VSTR("type unbounded_character_array is array(integer range <>) of character;"),
VSTR("subtype ch_buf_type is unbounded_character_array(0..YY_BUF_SIZE + 1);"),
VSTR("yy_ch_buf : ch_buf_type;"), VSTR("yy_cp, yy_bp : integer;"),
VSTR(""),
VSTR("-- yy_hold_char holds the character lost when yytext is formed"),
VSTR("yy_hold_char : character;"),
VSTR("yy_c_buf_p : integer; -- points to current character in buffer"),
VSTR(""),
VSTR("function YYText return string;"),
VSTR("function YYLength return integer;"),
VSTR("procedure YY_DO_BEFORE_ACTION;"),
VSTR("--These variables are needed between calls to YYLex."),
VSTR("yy_init : boolean := true; -- do we need to initialize YYLex?"),
VSTR("yy_start : integer := 0; -- current start state number"),
VSTR("subtype yy_state_type is integer;"),
VSTR("yy_last_accepting_state : yy_state_type;"),
VSTR("yy_last_accepting_cpos : integer;"),
VSTR("%%"),
VSTR("function YYText return string is"),
VSTR(" i : integer;"),
VSTR(" str_loc : integer := 1;"),
VSTR(" buffer : string(1..1024);"),
VSTR(" EMPTY_STRING : constant string := """";"),
VSTR("begin"),
VSTR(" -- find end of buffer"),
VSTR(" i := yytext_ptr;"),
VSTR(" while ( yy_ch_buf(i) /= ASCII.NUL ) loop"),
VSTR(" buffer(str_loc ) := yy_ch_buf(i);"),
VSTR(" i := i + 1;"),
VSTR(" str_loc := str_loc + 1;"),
VSTR(" end loop;"),
VSTR("-- return yy_ch_buf(yytext_ptr.. i - 1);"),
VSTR(""),
VSTR(" if (str_loc < 2) then"),
VSTR(" return EMPTY_STRING;"),
VSTR(" else"),
VSTR(" return buffer(1..str_loc-1);"),
VSTR(" end if;"),
VSTR(""),
VSTR("end;"),
VSTR(""),
VSTR("-- returns the length of the matched text"),
VSTR("function YYLength return integer is"),
VSTR("begin"), VSTR(" return yy_cp - yy_bp;"),
VSTR("end YYLength;"),
VSTR(""),
VSTR("-- done after the current pattern has been matched and before the"),
VSTR("-- corresponding action - sets up yytext"),
VSTR(""),
VSTR("procedure YY_DO_BEFORE_ACTION is"),
VSTR("begin"),
VSTR(" yytext_ptr := yy_bp;"),
VSTR(" yy_hold_char := yy_ch_buf(yy_cp);"),
VSTR(" yy_ch_buf(yy_cp) := ASCII.NUL;"),
VSTR(" yy_c_buf_p := yy_cp;"),
VSTR("end YY_DO_BEFORE_ACTION;"),
VSTR("")
--DFA TEMPLATE END
);
DFA_CURRENT_LINE : INTEGER := 1;
IO_TEMPLATE : constant FILE_ARRAY := (
--IO TEMPLATE START
VSTR("with text_io; use text_io;"),
VSTR(""),
VSTR("%%"),
VSTR("user_input_file : file_type;"),
VSTR("user_output_file : file_type;"),
VSTR("NULL_IN_INPUT : exception;"),
VSTR("AFLEX_INTERNAL_ERROR : exception;"),
VSTR("UNEXPECTED_LAST_MATCH : exception;"),
VSTR("PUSHBACK_OVERFLOW : exception;"),
VSTR("AFLEX_SCANNER_JAMMED : exception;"),
VSTR("type eob_action_type is ( EOB_ACT_RESTART_SCAN,"),
VSTR(" EOB_ACT_END_OF_FILE,"),
VSTR(" EOB_ACT_LAST_MATCH );"),
VSTR("YY_END_OF_BUFFER_CHAR : constant character:= ASCII.NUL;"),
VSTR("yy_n_chars : integer; -- number of characters read into yy_ch_buf"),
VSTR(""),
VSTR("-- true when we've seen an EOF for the current input file"),
VSTR("yy_eof_has_been_seen : boolean;"), VSTR(""),
VSTR("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer);"),
VSTR("function yy_get_next_buffer return eob_action_type;"),
VSTR("procedure yyunput( c : character; yy_bp: in out integer );"),
VSTR("procedure unput(c : character);"),
VSTR("function input return character;"),
VSTR("procedure output(c : character);"),
VSTR("function yywrap return boolean;"),
VSTR("procedure Open_Input(fname : in String);"),
VSTR("procedure Close_Input;"),
VSTR("procedure Create_Output(fname : in String := """");"),
VSTR("procedure Close_Output;"),
VSTR("%%"),
VSTR("-- gets input and stuffs it into 'buf'. number of characters read, or YY_NULL,"),
VSTR("-- is returned in 'result'."),
VSTR(""),
VSTR("procedure YY_INPUT(buf: out unbounded_character_array; result: out integer; max_size: in integer) is"),
VSTR(" c : character;"),
VSTR(" i : integer := 1;"),
VSTR(" loc : integer := buf'first;"),
VSTR("begin"),
VSTR(" if (is_open(user_input_file)) then"),
VSTR(" while ( i <= max_size ) loop"),
VSTR(" if (end_of_line(user_input_file)) then -- Ada ate our newline, put it back on the end."),
VSTR(" buf(loc) := ASCII.LF;"),
VSTR(" skip_line(user_input_file, 1);"),
VSTR(" else"),
VSTR(" get(user_input_file, buf(loc));"),
VSTR(" end if;"),
VSTR(""),
VSTR(" loc := loc + 1;"),
VSTR(" i := i + 1;"),
VSTR(" end loop;"),
VSTR(" else"),
VSTR(" while ( i <= max_size ) loop"),
VSTR(" if (end_of_line) then -- Ada ate our newline, put it back on the end."),
VSTR(" buf(loc) := ASCII.LF;"),
VSTR(" skip_line(1);"),
VSTR("%%"),
VSTR(""),
VSTR(" else"),
VSTR(" get(buf(loc));"),
VSTR(" end if; "),
VSTR(""),
VSTR(" loc := loc + 1;"),
VSTR(" i := i + 1;"),
VSTR(" end loop;"),
VSTR(" end if; -- for input file being standard input"),
VSTR(""),
VSTR(" result := i - 1; "),
VSTR(" exception"),
VSTR(" when END_ERROR => result := i - 1;"),
VSTR(" -- when we hit EOF we need to set yy_eof_has_been_seen"),
VSTR(" yy_eof_has_been_seen := true;"),
VSTR("end YY_INPUT;"),
VSTR(""),
VSTR("-- yy_get_next_buffer - try to read in new buffer"),
VSTR("--"),
VSTR("-- returns a code representing an action"),
VSTR("-- EOB_ACT_LAST_MATCH - "),
VSTR("-- EOB_ACT_RESTART_SCAN - restart the scanner"),
VSTR("-- EOB_ACT_END_OF_FILE - end of file"),
VSTR(""),
VSTR("function yy_get_next_buffer return eob_action_type is"),
VSTR(" dest : integer := 0;"),
VSTR(" source : integer := yytext_ptr - 1; -- copy prev. char, too"),
VSTR(" number_to_move : integer;"),
VSTR(" ret_val : eob_action_type;"),
VSTR(" num_to_read : integer;"),
VSTR("begin "),
VSTR(" if ( yy_c_buf_p > yy_n_chars + 1 ) then"),
VSTR(" raise NULL_IN_INPUT;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" -- try to read more data"),
VSTR(""),
VSTR(" -- first move last chars to start of buffer"),
VSTR(" number_to_move := yy_c_buf_p - yytext_ptr;"),
VSTR(""),
VSTR(" for i in 0..number_to_move - 1 loop"),
VSTR(" yy_ch_buf(dest) := yy_ch_buf(source);"),
VSTR(" dest := dest + 1;"),
VSTR(" source := source + 1;"),
VSTR(" end loop;"),
VSTR(" "),
VSTR(" if ( yy_eof_has_been_seen ) then"),
VSTR(" -- don't do the read, it's not guaranteed to return an EOF,"),
VSTR(" -- just force an EOF"),
VSTR(""),
VSTR(" yy_n_chars := 0;"),
VSTR(" else"),
VSTR(" num_to_read := YY_BUF_SIZE - number_to_move - 1;"),
VSTR(""),
VSTR(" if ( num_to_read > YY_READ_BUF_SIZE ) then"),
VSTR(" num_to_read := YY_READ_BUF_SIZE;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" -- read in more data"),
VSTR(" YY_INPUT( yy_ch_buf(number_to_move..yy_ch_buf'last), yy_n_chars, num_to_read );"),
VSTR(" end if;"),
VSTR(" if ( yy_n_chars = 0 ) then"),
VSTR(" if ( number_to_move = 1 ) then"),
VSTR(" ret_val := EOB_ACT_END_OF_FILE;"),
VSTR(" else"),
VSTR(" ret_val := EOB_ACT_LAST_MATCH;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" yy_eof_has_been_seen := true;"),
VSTR(" else"),
VSTR(" ret_val := EOB_ACT_RESTART_SCAN;"),
VSTR(" end if;"),
VSTR(" "),
VSTR(" yy_n_chars := yy_n_chars + number_to_move;"),
VSTR(" yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
VSTR(" yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
VSTR(""),
VSTR(" -- yytext begins at the second character in"),
VSTR(" -- yy_ch_buf; the first character is the one which"),
VSTR(" -- preceded it before reading in the latest buffer;"),
VSTR(" -- it needs to be kept around in case it's a"),
VSTR(" -- newline, so yy_get_previous_state() will have"),
VSTR(" -- with '^' rules active"),
VSTR(""),
VSTR(" yytext_ptr := 1;"),
VSTR(""),
VSTR(" return ret_val;"),
VSTR("end yy_get_next_buffer;"),
VSTR(""),
VSTR("procedure yyunput( c : character; yy_bp: in out integer ) is"),
VSTR(" number_to_move : integer;"),
VSTR(" dest : integer;"),
VSTR(" source : integer;"),
VSTR(" tmp_yy_cp : integer;"),
VSTR("begin"),
VSTR(" tmp_yy_cp := yy_c_buf_p;"),
VSTR(" yy_ch_buf(tmp_yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
VSTR(""),
VSTR(" if ( tmp_yy_cp < 2 ) then"),
VSTR(" -- need to shift things up to make room"),
VSTR(" number_to_move := yy_n_chars + 2; -- +2 for EOB chars"),
VSTR(" dest := YY_BUF_SIZE + 2;"),
VSTR(" source := number_to_move;"),
VSTR(""),
VSTR(" while ( source > 0 ) loop"),
VSTR(" dest := dest - 1;"),
VSTR(" source := source - 1;"),
VSTR(" yy_ch_buf(dest) := yy_ch_buf(source);"),
VSTR(" end loop;"),
VSTR(""),
VSTR(" tmp_yy_cp := tmp_yy_cp + dest - source;"),
VSTR(" yy_bp := yy_bp + dest - source;"),
VSTR(" yy_n_chars := YY_BUF_SIZE;"),
VSTR(""),
VSTR(" if ( tmp_yy_cp < 2 ) then"),
VSTR(" raise PUSHBACK_OVERFLOW;"),
VSTR(" end if;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" if ( tmp_yy_cp > yy_bp and then yy_ch_buf(tmp_yy_cp-1) = ASCII.LF ) then"),
VSTR(" yy_ch_buf(tmp_yy_cp-2) := ASCII.LF;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" tmp_yy_cp := tmp_yy_cp - 1;"),
VSTR(" yy_ch_buf(tmp_yy_cp) := c;"),
VSTR(""),
VSTR("-- Note: this code is the text of YY_DO_BEFORE_ACTION, only"),
VSTR("-- here we get different yy_cp and yy_bp's"),
VSTR(" yytext_ptr := yy_bp;"),
VSTR(" yy_hold_char := yy_ch_buf(tmp_yy_cp);"),
VSTR(" yy_ch_buf(tmp_yy_cp) := ASCII.NUL;"),
VSTR(" yy_c_buf_p := tmp_yy_cp;"),
VSTR("end yyunput;"),
VSTR(""),
VSTR("procedure unput(c : character) is"),
VSTR("begin"),
VSTR(" yyunput( c, yy_bp );"),
VSTR("end unput;"),
VSTR(""),
VSTR("function input return character is"),
VSTR(" c : character;"),
VSTR(" yy_cp : integer := yy_c_buf_p;"),
VSTR("begin"),
VSTR(" yy_ch_buf(yy_cp) := yy_hold_char;"),
VSTR(""),
VSTR(" if ( yy_ch_buf(yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then"),
VSTR(" -- need more input"),
VSTR(" yytext_ptr := yy_c_buf_p;"),
VSTR(" yy_c_buf_p := yy_c_buf_p + 1;"),
VSTR(""),
VSTR(" case yy_get_next_buffer is"),
VSTR(" -- this code, unfortunately, is somewhat redundant with"),
VSTR(" -- that above"),
VSTR(""),
VSTR(" when EOB_ACT_END_OF_FILE =>"),
VSTR(" if ( yywrap ) then"),
VSTR(" yy_c_buf_p := yytext_ptr;"),
VSTR(" return ASCII.NUL;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" yy_ch_buf(0) := ASCII.LF;"),
VSTR(" yy_n_chars := 1;"),
VSTR(" yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
VSTR(" yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
VSTR(" yy_eof_has_been_seen := false;"),
VSTR(" yy_c_buf_p := 1;"),
VSTR(" yytext_ptr := yy_c_buf_p;"),
VSTR(" yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR(""),
VSTR(" return ( input );"),
VSTR(" when EOB_ACT_RESTART_SCAN =>"),
VSTR(" yy_c_buf_p := yytext_ptr;"),
VSTR(""),
VSTR(" when EOB_ACT_LAST_MATCH =>"),
VSTR(" raise UNEXPECTED_LAST_MATCH;"),
VSTR(" when others => null;"),
VSTR(" end case;"),
VSTR(" end if;"),
VSTR(""),
VSTR(" c := yy_ch_buf(yy_c_buf_p);"),
VSTR(" yy_c_buf_p := yy_c_buf_p + 1;"),
VSTR(" yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
VSTR(""),
VSTR(" return c;"),
VSTR("end input;"),
VSTR(""),
VSTR("procedure output(c : character) is"),
VSTR("begin"),
VSTR(" if (is_open(user_output_file)) then"),
VSTR(" text_io.put(user_output_file, c);"),
VSTR(" else"),
VSTR(" text_io.put(c);"),
VSTR(" end if;"),
VSTR("end output;"),
VSTR(""),
VSTR("-- default yywrap function - always treat EOF as an EOF"),
VSTR("function yywrap return boolean is"),
VSTR("begin"),
VSTR(" return true;"),
VSTR("end yywrap;"),
VSTR(""),
VSTR("procedure Open_Input(fname : in String) is"),
VSTR("begin"),
VSTR(" yy_init := true;"),
VSTR(" open(user_input_file, in_file, fname);"),
VSTR("end Open_Input;"),
VSTR(""),
VSTR("procedure Create_Output(fname : in String := """") is"),
VSTR("begin"),
VSTR(" if (fname /= """") then"),
VSTR(" create(user_output_file, out_file, fname);"),
VSTR(" end if;"),
VSTR("end Create_Output;"),
VSTR(""),
VSTR("procedure Close_Input is"),
VSTR("begin"),
VSTR(" if (is_open(user_input_file)) then"),
VSTR(" text_io.close(user_input_file);"),
VSTR(" end if;"),
VSTR("end Close_Input;"),
VSTR(""),
VSTR("procedure Close_Output is"),
VSTR("begin"),
VSTR(" if (is_open(user_output_file)) then"),
VSTR(" text_io.close(user_output_file);"),
VSTR(" end if;"),
VSTR("end Close_Output;"),
VSTR("")
--IO TEMPLATE END
);
IO_CURRENT_LINE : INTEGER := 1;
procedure TEMPLATE_OUT(OUTFILE : in FILE_TYPE;
CURRENT_TEMPLATE : in FILE_ARRAY;
LINE_NUMBER : in out INTEGER) is
BUF : VSTRING;
begin
while (not (LINE_NUMBER > CURRENT_TEMPLATE'LAST)) loop
BUF := CURRENT_TEMPLATE(LINE_NUMBER);
LINE_NUMBER := LINE_NUMBER + 1;
if ((FILE_STRING.LEN(BUF) >= 2) and then ((CHAR(BUF, 1) = '%') and (CHAR(
BUF, 2) = '%'))) then
exit;
else
FILE_STRING.PUT_LINE(OUTFILE, BUF);
end if;
end loop;
end TEMPLATE_OUT;
procedure GENERATE_DFA_FILE is
DFA_OUT_FILE : FILE_TYPE;
begin
EXTERNAL_FILE_MANAGER.GET_DFA_FILE(DFA_OUT_FILE);
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "package " & TSTRING.STR(MISC.BASENAME) &
"_dfa" & " is");
if (DDEBUG) then
-- make a scanner that output acceptance information
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "aflex_debug : boolean := true;");
else
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "aflex_debug : boolean := false;");
end if;
TEMPLATE_OUT(DFA_OUT_FILE, DFA_TEMPLATE, DFA_CURRENT_LINE);
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_dfa;"
);
TEXT_IO.NEW_LINE(DFA_OUT_FILE);
TEXT_IO.PUT(DFA_OUT_FILE, "with " & TSTRING.STR(MISC.BASENAME) & "_dfa" &
"; ");
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "use " & TSTRING.STR(MISC.BASENAME) & "_dfa"
& "; ");
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "package body " & TSTRING.STR(MISC.BASENAME)
& "_dfa" & " is");
TEMPLATE_OUT(DFA_OUT_FILE, DFA_TEMPLATE, DFA_CURRENT_LINE);
TEXT_IO.PUT_LINE(DFA_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_dfa;"
);
end GENERATE_DFA_FILE;
procedure GENERATE_IO_FILE is
IO_OUT_FILE : FILE_TYPE;
begin
EXTERNAL_FILE_MANAGER.GET_IO_FILE(IO_OUT_FILE);
TEXT_IO.PUT(IO_OUT_FILE, "with " & TSTRING.STR(MISC.BASENAME) & "_dfa" &
"; ");
TEXT_IO.PUT_LINE(IO_OUT_FILE, "use " & TSTRING.STR(MISC.BASENAME) & "_dfa"
& "; ");
TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
TEXT_IO.PUT_LINE(IO_OUT_FILE, "package " & TSTRING.STR(MISC.BASENAME) &
"_io" & " is");
TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
TEXT_IO.PUT_LINE(IO_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_io;")
;
TEXT_IO.NEW_LINE(IO_OUT_FILE);
TEXT_IO.PUT_LINE(IO_OUT_FILE, "package body " & TSTRING.STR(MISC.BASENAME)
& "_io" & " is");
TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
-- If we're generating a scanner for interactive mode we need to generate
-- a YY_INPUT that stops at the end of each line
if INTERACTIVE then
TEXT_IO.PUT_LINE(IO_OUT_FILE,
" i := i + 1; -- update counter, miss end of loop");
TEXT_IO.PUT_LINE(IO_OUT_FILE,
" exit; -- in interactive mode return at end of line.");
end if;
TEMPLATE_OUT(IO_OUT_FILE, IO_TEMPLATE, IO_CURRENT_LINE);
TEXT_IO.PUT_LINE(IO_OUT_FILE, "end " & TSTRING.STR(MISC.BASENAME) & "_io;")
;
end GENERATE_IO_FILE;
end TEMPLATE_MANAGER;